home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / May / di9805fn / StrTst01.pas < prev    next >
Pascal/Delphi Source File  |  1998-01-13  |  10KB  |  332 lines
  1. unit StrTst01;
  2. { Related to my File|New Column on AnsiStrings in Delphi Informant, May, 1998.
  3.   This project demonstrates routines in the HyperString library from
  4.   EFD Systems.  To download the free Delphi 3 *.dcu (HSTR.ZIP) needed
  5.   to run this program, visit their Web Site at www.mindspring.com/~efd.
  6.   Also, be sure to read the paper on AnsiStrings while you're there.
  7.   To report bugs or make suggestions, please E-Mail me at acmdoc@aol.com.
  8.   (One of the areas that definately could be enhanced here is the relationship
  9.   between to new string and the memo that displays the parsed file.)
  10.   Thanks, and enjoy!  Alan C. Moore }
  11.  
  12. interface
  13.  
  14. uses
  15.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  16.   StdCtrls, ComCtrls;
  17.  
  18. {Utility types, procedures and functions}
  19. type
  20.  
  21.   {This record and the two routines which follow are based on code posted
  22.   on the COBB/ZD DDJ-Thread by Ralph Friedman of Herrsching, Germany}
  23.   TMemoInfo = record
  24.     AbsOffset: integer;
  25.     Line: integer;
  26.     Col:  integer;
  27.   end;
  28.  
  29. type
  30.   TForm1 = class(TForm)
  31.     StartParseBtn: TButton;
  32.     Memo1: TMemo;
  33.     OpenDialog1: TOpenDialog;
  34.     StatusBar1: TStatusBar;
  35.     FindPositionBtn: TButton;
  36.     FindWordBtn: TButton;
  37.     Label1: TLabel;
  38.     WordEdit: TEdit;
  39.     Label2: TLabel;
  40.     PosEdit: TEdit;
  41.     NextOfSameWordBtn: TButton;
  42.     NextWordBtn: TButton;
  43.     PreviousWordBtn: TButton;
  44.     SetTagDelimsBtn: TButton;
  45.     GetTaggedPhraseBtn: TButton;
  46.     GetNextTaggedPhraseBtn: TButton;
  47.     Label3: TLabel;
  48.     LoadFileBtn: TButton;
  49.     procedure StartParseBtnClick(Sender: TObject);
  50.     procedure FindPositionBtnClick(Sender: TObject);
  51.     procedure FormCreate(Sender: TObject);
  52.     procedure FindWordBtnClick(Sender: TObject);
  53.     procedure NextOfSameWordBtnClick(Sender: TObject);
  54.     procedure NextWordBtnClick(Sender: TObject);
  55.     procedure PreviousWordBtnClick(Sender: TObject);
  56.     procedure Memo1DblClick(Sender: TObject);
  57.     procedure GetTaggedPhraseBtnClick(Sender: TObject);
  58.     procedure SetTagDelimsBtnClick(Sender: TObject);
  59.     procedure GetNextTaggedPhraseBtnClick(Sender: TObject);
  60.     procedure LoadFileBtnClick(Sender: TObject);
  61.   private
  62.     { Private declarations }
  63.   public
  64.     { Public declarations }
  65.     ALongString : string;          { Current String being parsed }
  66.     AParsedString : string;        { string to match memo structure }
  67.     NextSubSring : string;         { SubString starting at current location }
  68.     TokenPos,
  69.     TokenCount,
  70.     WordCount : integer;
  71.     FileIsOpen,
  72.     NumberEntered,
  73.     WordEntered : boolean;
  74.     StartingDelimiter,
  75.     EndingDelimiter : string;
  76.     procedure GetMemoPos(AMemo: TMemo; var AMemoInfo: TMemoInfo);
  77.     procedure SetMemoPos(AMemo: TMemo; var AMemoInfo: TMemoInfo);
  78.     procedure FindMemoPos(AMemo: TMemo; OffsetIn : integer;
  79.                                    var AMemoInfo: TMemoInfo);
  80.   end;
  81.  
  82. var
  83.   Form1: TForm1;
  84.  
  85. implementation
  86.  
  87. {$R *.DFM}
  88. uses  HyperStr, SetDelim;
  89.  
  90. procedure TForm1.GetMemoPos(AMemo: TMemo; var AMemoInfo: TMemoInfo);
  91. begin
  92.   with AMemo, AMemoInfo do begin
  93.     AbsOffset := SelStart;   { Offset of cursor in memo }
  94.     Line := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0);
  95.       { Line number of line containing cursor. }
  96.     Col := SelStart - SendMessage(Handle, EM_LINEINDEX, Line, 0);
  97.       { Offset of cursor in line. }
  98.   end;
  99. end;
  100.  
  101. procedure TForm1.FindMemoPos(AMemo: TMemo; OffsetIn : integer;
  102.                                    var AMemoInfo: TMemoInfo);
  103. begin
  104.     with AMemo, AMemoInfo do begin
  105.       SelStart := OffsetIn;
  106.         { First move curser to current location found }
  107.     AbsOffset := SelStart;   { Offset of cursor in memo }
  108.     Line := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0);
  109.       { Line number of line containing cursor. }
  110.     Col := SelStart - SendMessage(Handle, EM_LINEINDEX, Line, 0);
  111.       { Offset of cursor in line. }
  112.     end;
  113. end;
  114.  
  115. procedure TForm1.SetMemoPos(AMemo: TMemo; var AMemoInfo: TMemoInfo);
  116. { Set cursor position in AMemo to that specified in AMemoInfo }
  117. begin
  118.   with AMemo, AMemoInfo do
  119.     begin
  120.     SelStart := AbsOffset;
  121.     SelLength := Length(WordEdit.Text);
  122.     SendMessage(Handle, EM_SETSEL, SelStart, SelLength);
  123.     end;
  124. end;
  125.  
  126. procedure TForm1.StartParseBtnClick(Sender: TObject);var
  127. AIndex : integer;
  128. TableOfDelims,
  129. TempString : string;
  130.  
  131. begin
  132.    AIndex := 1;
  133.    TokenCount := 0;
  134.    TokenPos := 1;
  135.    if NOT FileIsOpen then exit
  136.  
  137.    else
  138.    begin
  139.      AParsedString := '';
  140.      TableOfDelims := #9#10#13#32#44#46#59;//common delimiters in freeform text
  141.      Form1.Repaint;
  142.      // first process first word
  143.      TempString := ParseWord(ALongString,TableOfDelims,AIndex);
  144.      AParsedString := TempString;
  145.      Memo1.Lines.Add(TempString);
  146.      // now process the other words
  147.      repeat
  148.        TempString := ParseWord(ALongString,TableOfDelims,AIndex);
  149.        AParsedString := Concat(AParsedString, '  ', TempString);
  150.        Memo1.Lines.Add(TempString);
  151.      until ((AIndex>Length(ALongString)) or (AIndex<1));
  152.      WordCount := CountW(AParsedString, TableOfDelims); {uses multiple delimiters}
  153.      if SetDelimiter(' ') then      {Default Delimiter is a ' '}
  154.      TokenCount := GetTokenCnt(AParsedString);
  155.      StatusBar1.Panels[0].Text := IntToStr(WordCount)+ ' words found.';
  156.      StatusBar1.Panels[1].Text := IntToStr(TokenCount) + ' tokens found.';
  157.      FileIsOpen := True;
  158.    end;
  159. end;
  160.  
  161. procedure TForm1.FindPositionBtnClick(Sender: TObject);
  162. begin
  163.   if NOT FileIsOpen then
  164.     begin
  165.       MessageDlg('No File Open', mtError, [mbOK], 0);
  166.       Exit;
  167.     end;
  168.   if (WordEdit.Text='') then
  169.     begin
  170.       MessageDlg('No Word Entered', mtError, [mbOK], 0);
  171.       Exit;
  172.     end;
  173.   TokenPos :=  Pos(WordEdit.Text, AParsedString);
  174.   PosEdit.Text := IntToStr(TokenPos);
  175. end;
  176.  
  177. procedure TForm1.FormCreate(Sender: TObject);
  178. begin
  179.     FileIsOpen := False;
  180.     NumberEntered := False;
  181.     WordEntered := False;
  182.     StartingDelimiter := '<';
  183.     EndingDelimiter := '>';
  184. end;
  185.  
  186. procedure TForm1.FindWordBtnClick(Sender: TObject);
  187. begin
  188.   if NOT FileIsOpen then
  189.     begin
  190.       MessageDlg('No File Open', mtError, [mbOK], 0);
  191.       Exit;
  192.     end;
  193.   if (PosEdit.Text='') then
  194.     begin
  195.       MessageDlg('No Position Entered', mtError, [mbOK], 0);
  196.       Exit;
  197.     end;
  198.   WordEdit.Text := GetToken(AParsedString, StrToInt(PosEdit.Text));
  199. end;
  200.  
  201. procedure TForm1.NextOfSameWordBtnClick(Sender: TObject);
  202. var
  203. TempPos : integer;
  204. AMemoInfo : TMemoInfo;
  205. TokenNum : integer;
  206. begin
  207.   GetMemoPos(Memo1, AMemoInfo);
  208.   TempPos := TokenPos + Length(WordEdit.Text) + 2;
  209.   NextSubSring := Copy(AParsedString, TempPos,
  210.                        Length(AParsedString)- TempPos);
  211.   if NOT NextToken(NextSubSring, TokenPos) then
  212.       begin
  213.       MessageDlg('No More Entries Found', mtError, [mbOK], 0);
  214.       Exit;
  215.     end;
  216.   TokenPos :=  Pos(('  '+WordEdit.Text), NextSubSring);
  217.   if TokenPos=0 then
  218.     begin
  219.       MessageDlg('No More Entries Found', mtError, [mbOK], 0);
  220.       Exit;
  221.     end;
  222.    TokenPos :=  TokenPos + Length(AParsedString)-Length(NextSubSring)+1;
  223.    PosEdit.Text := IntToStr(TokenPos);
  224.    TokenNum := GetTokenNum(AParsedString, TokenPos);
  225.    AMemoInfo.Line := TokenNum-1;
  226.    AMemoInfo.Col := 0;
  227.    AMemoInfo.AbsOffset :=  TokenPos-1;
  228.    SetMemoPos(Memo1, AMemoInfo);
  229. end;
  230.  
  231. procedure TForm1.NextWordBtnClick(Sender: TObject);
  232. var
  233. AMemoInfo : TMemoInfo;
  234. TokenNum : integer;
  235. begin
  236.   if NOT NextToken(AParsedString, TokenPos) then  Exit;
  237.   NextToken(AParsedString, TokenPos);
  238.   PosEdit.Text := IntToStr(TokenPos);
  239.   WordEdit.Text := GetToken(AParsedString, TokenPos);
  240.   TokenNum := GetTokenNum(AParsedString, TokenPos);
  241.   AMemoInfo.Line := TokenNum-1;
  242.   AMemoInfo.Col := 0;
  243.   AMemoInfo.AbsOffset :=  TokenPos-1;
  244.   SetMemoPos(Memo1, AMemoInfo);
  245. end;
  246.  
  247. procedure TForm1.PreviousWordBtnClick(Sender: TObject);
  248. var
  249. AMemoInfo : TMemoInfo;
  250. begin
  251.   if NOT PrevToken(AParsedString, TokenPos) then  Exit;
  252.   PrevToken(AParsedString, TokenPos);
  253.   PosEdit.Text := IntToStr(TokenPos);
  254.   WordEdit.